perm filename PUTCH3[AI,JMC] blob
sn#005440 filedate 1971-08-13 generic text, type T, neo UTF8
TITLE PUTCH
;AC ASSIGNMENTS
P=17 ;PUSHDOWN LIST
MOVER=16 ;PIECE TO BE MOVED
DEST=15 ;DESTINATION OF PIECE
I=14 ;AN INDEX VARIABLE
OLD=13 ;OLD LOCATION OF MOVING PIECE
MDIR=12 ;IN GENERAL A MULTIPLE OF DIR TO SAVE TIME
DIR=11 ;AN INDEX BY DIRECTION
IBEAR=10 ;INDEX VARIABLE FOR BEARINGS
B=7 ;SIMILAR
K=6 ;OFTEN HOLDS KIND OF SOME PIECE
M=5 ;INDEX VARIABLE
N=4 ;USUALLY ASSOCIATED WITH NEXT SQUARE CONSIDERED
T2=3 ;TEMP CELL
T1=2 ;ANOTHER TEMP CELL
FL=0 ;FLAG REGISTER
;ACS 0,1 NOT USED BY PUTCH
;PEICE KINDS
PAWN==0
ROOK==1
KNIGHT==2
BISHOP==3
QUEEN==4
KING==5
;DESCRIPTION OF TABLES USED
;NEXT THIS TABLE INDEXED BY DIRECTION AND SQUARE GIVES NEXT
; SQUARE IN THAT DIRECTION -1 MEANS OFF BOARD
; LEFT HALF HAS MDIR IN INDEX FIELD FOR MAGIC
;LOC INDEXED BY PIECE GIVES LOCATION OF PIECE
; -1 MEANS OFF BOARD
;OCC INDEXED BY SQUARE GIVES OCCUPANT OF SQUARE
; -1 MEANS NOT OCCUPIED
;JBEAR INDEXED BY DIRECTION AND SQUARE GIVES PIECE BEARING
; ON THAT SQUARE FROM THAT DIRECTION. -1 MEANS NONE
; 200000 BIT IN LEFT HALF MEANS ONLY PSEUDO-BEARING
; FOR KING OR A PSEUDO BEARING FOR A PAWN MOVE NOT A CAPUTRE
; 100000 MEANS A PAWN FORWARD MOVE AND 40000 A PSEUDO PAWN
; CAPTURE
;KDIR INDEXED BY COLOR AND SQUARE GIVES DIRECTION FROM
; WHICH KING OF THAT COLOR BEARS UPON SQUARE -1 MEANS
; KING DOES NOT BEAR ON SQUARE
;JMOVE TABLE OF MOVES INDEXED BY PIECE, DIRECTION, AND DISTANCE
; GIVES PSEUDO MOVE (IN FORM DIRECTION*100+DEST)
; -1 MEANS NO MOVE. HOWEVER PAWN MOVES ARE FIRST 4
; ENTRIES IN PAWN BLOCK AND KNIGHTS FIRST 10
; 200000 BIT IN LEFT HALF MEANS ONLY A PSEUDO-MOVE
; FOR A KING OR A PSEUDO MOVE FOR A PAWN FORWARD MOVE
; 100000 MEANS A PAWN FORWARD MOVE AND 40000 A PSEUDO PAWN
; CAPTURE
;KIND INDEXED BY PIECE GIVES KIND OF THAT PIECE
;VALUE INDEXED BY KIND OF PIECE GIVES VALUE
;RANK INDEXED BY SQUARE GIVES ITS RANK
;FILE SAME FOR ITS FILE
;OPP INDEXED BY DIRECTION GIVES OPPOSITE DIRECTION
;LM LEFT HALF IS -NUMBER OF POSSIBLE ENTRIES IN MOVE TABLE
; RIGHT HALF START OF PIECES BLOCK IN MOVE TABLE
; EXCEPT PAWN AND KNIGHTS WHERE LEFT HALF IS 3 OR 7
; RESPECTIVELY
;DISTBL INDEXED BY SQUARES TO GIVE DISTANCE NEED AN
; LDB AC,DISTBL(SQ1) WHERE SQ1 IS FIRST SQUARE AND
; T1 IS SECOND SQUARE LOADS AC WITH DISTANCE
; BETWEEN SQ1 AND T1
;EIGHTX INDEX BY DIRECTION GIVES DIRECTION TIMES 10
;PIECES NUMBERED 0 TO 37. WHITE IS 0 TO 17, BLACK 20 TO 37
;BOARD SQUARES NUMBERED 0 TO 77
;DIRECTIONS AS FOLLOWES
; 10 11
; 17 4 1 5 12
; 0 2
; 16 7 3 6 13
; 15 14
;VIEWED FROM WHITE'S SIDE OF THE BOARD
;WARNING: ALL NUMBERS IN THIS PROGRAM ARE IN OCTAL!!!!!!
PUTCH: TRNN FL,TIMR
JRST NNTM
MOVEI T1,0
CALLI T1,31
CONI 730,SVPTM#
AOS PTCTR
NNTM: SKIPN T1,POSTB(DEST) ;GET SDB WORD FOR DEST SQ
MOVE T1,OFBTB(MOVER) ;IF OFF BOARD PUT IT WHERE IT GOES
MOVEM T1,@PCTB(MOVER) ;MOVE IT
SKIPGE OLD,LOC(MOVER) ;LOAD OLD AND CHECK IF
;COMMING FROM OFF BOARD
JRST L11A ;YES FROM OFF BOARD
MOVNI T2,1 ;NO, READY TO ERASE OLD MOVES AND
;BEARINGS. SET T2 TO -1 FOR THIS
SKIPL I,LM(MOVER) ;GET POINTER TO MOVE TABLE
JRST L11P ;PAWNS AND KNIGHTS HAVE POS. ENTRIES
HLRE M,I ;NOT A PAWN OR KNIGHT. SET UP M
;WITH NUMBER OF DIRECTIONS TO CHECK
JRST PL4 ;GO DO IT
L11P: TLC I,-1 ;DO PAWNS, KNIGHTS SET LEFT OF I TO
;-NUMBER OF LOCATIONS TO ERASE
SKIPGE T1,JMOVE(I) ;GET THIS MOVE
JRST L11PA ;NO MOVE TO ERASE
MOVEM T2,JMOVE(I) ;ERASE IT
MOVEM T2,JBEAR(T1) ;AND ALSO ASSOCIATED BEARING
L11PA: AOBJN I,L11P+1 ;GO DO MORE
JRST L11A ;ALL DONE
PL2: ADDI I,10 ;SET UP FOR NEXT DIRECTION
ANDI I,-10 ;WHICH IS A MULTIPLE OF 10
PL4: SKIPGE T1,JMOVE(I) ;GET THIS MOVE
JRST PL3 ;NO MOVE THERE, MUST BE END OF DIRECTION
PL1: MOVEM T2,JBEAR(T1) ;ERASE BEARING
MOVEM T2,JMOVE(I) ;AND MOVE
SKIPL T1,JMOVE+1(I) ;ANOTHER MOVE AROUND?
AOJA I,PL1 ;YES DO IT
PL3: AOJL M,PL2 ;NO, TRY NEW DIRECTION
L11A: MOVEM DEST,LOC(MOVER) ;OLD MOVES ALL ERASED
;UPDATE LOC TABLE
SETOM OCC(OLD) ;SET OLD SQUARE UNOCCUPIED
SKIPL DEST ;MOVING OFF BOARD?
MOVEM MOVER,OCC(DEST) ;NO, SO OCCUPY NEW SQUARE
JUMPGE OLD,L21 ;NEXT CODE ONLY IF CAME FROM OFF BOARD
MOVE T1,KIND(MOVER) ;UPDATING MATERIAL BALACNE
MOVE T1,VALUE(T1)
CAIGE MOVER,20 ;WHOSE PIECE
ADDM T1,WCOUNT# ;WHITE
CAIL MOVER,20
ADDM T1,BCOUNT# ;OR BLACK
JRST P1 ;FROM OFF BOARD NEXT CODE NOT NEEDED
;UPDATE MOVES OF PIECES THAT USED TO BEAR ON MOVING PIECE
L21: MOVEI MDIR,0 ;START AT DIRECTION 0 MDIR=DIR*100
HRLZI DIR,-10 ;CHECK FIRST 10 DIRECTIONS
MOVE IBEAR,OLD ;INDEX INTO JBEAR
L24: SKIPGE B,JBEAR(IBEAR) ;GET PIECE BEARING HERE
JRST PD1 ;THERE ISN'T ONE
HRRZS B ;TO CLEAR PSEUDO FLAGS
MOVE K,KIND(B) ;GET KIND OF PIECE
CAIN K,PAWN ;IS IT PAWN
JRST PD2 ;PAWNS ARE SPECIAL
CAIN K,KING ;ALL OF THESE ARE PSEUDO-MOVES FOR KING
HRLI B,200000
SKIPGE N,NEXT(IBEAR) ;GET NEXT SQUARE IN THAT DIR.
JRST PD1 ;NO MORE IN THAT DIR.
MOVE T1,LOC(B) ;GET LOCATION OF BEARING PIECE
LDB M,DISTBL(OLD) ;GET DISTANCE TO NEW SQUARE
ADD M,EIGHTX(DIR) ;SETTING UP MOVE TABLE ENTRY
;LM(MOVER)+10*DIR+DISTANCE
ADD M,LM(B)
PD3: MOVEI T1,@N ;SINCE LEFT HALF OF NEXT WHICH LOADED
;N HAS MDIR IN INDEX FIELD THIS GIVES
;N+MDIR WHICH IS CORRECT INDEX INTO JBEAR
MOVEM B,JBEAR(T1) ;ENTER BEARING
HLLM B,JMOVE(M) ;MAY HAVE PSEUDO-MOVE FLAG
HRRZM T1,JMOVE(M) ;INDEX IS ALSO IN FORM OF MOVE
;SO ENTER IT
CAIE K,KING ;FOR KINGS UPDATE KDIR
JRST L25 ;ELSE SKIP THIS
MOVE T2,OPP(DIR) ;GET OPPOSITE DIRECTION
MOVE I,N ;START GENERATING INDEX TO KDIR
CAIL B,20 ;WHICH COLOR
IORI I,100 ;SET CORRECT INDEX
MOVEM T2,KDIR(I) ;STORE
L25: SKIPL OCC(N) ;WAS THERE A PIECE THERE
JRST PD1 ;IF YES, STOP UPDATING THIS DIR.
SKIPGE N,NEXT(T1) ;GET NEXT SQUARE
JRST PD1 ;OFF BOARD
AOJA M,PD3 ;UPDATE IT (CHANGE POINTER TO MOVE TABLE)
PD2: MOVE T1,RANK(OLD) ;HERE BE PAWNS
CAIGE B,20 ;SPECIAL CHECKING FOR POSSIBILITY
;OF MOVING 2 FORWARD ON FIRST MOVE
JRST L31 ;DO A BLACK PAWN
CAIE MDIR,300 ;CHECK FOR CORRECT DIR
JRST MIL1 ;NO, MAKE MOVE ILLEGAL (REMOVES CAPT)
CAIN T1,5 ;RANK OF FIVE MAY NEED TO ENTER 4TH MV
JRST L32
JRST MLEG1 ;NO, THIS MOVE NOW LEGAL
L31: CAIE MDIR,100 ;SAME FOR WHITD
JRST MIL1
CAIE T1,2
JRST MLEG1
L32: MOVE T1,OLD ;GET BEARING TABLE INDEX
CAIGE B,20 ;ONE SQUARE IN EITHER DIR. DEPENDING ON COLOR
ADDI T1,10
CAIL B,20
SUBI T1,10
HRLI B,100000 ;THIS IS A PAWN FORWARD MOVE
SKIPL OCC(T1) ;SHOULD IT BE PSEUDO
HRLI B,200000 ;YES
IOR T1,MDIR ;MAKE AN INDEX TO JBEAR
MOVEM B,JBEAR(T1) ;UPDATE BEARING
MOVE T2,LM(B) ;WANT TO UPDATE MOVE TABLE TOO
HRRZM T1,JMOVE+3(T2) ;ALWAYS 4TH ENTRY
HLLM B,JMOVE+3(T2) ;PUT IN PSEUDO- BIT IF NEC
MOVEI T1,100000 ;MAKE MOVE 3 LEGAL
HRLM T1,JMOVE+2(T2)
HRL T1,JBEAR(IBEAR)
JRST PD1
MIL1: MOVEI T1,40000 ;THE ILLEGAL (PSEUDO) BIT
HRLM T1,JBEAR(IBEAR) ;NOW IS PSEUDO
MOVE T2,LM(B) ;AND THE MOVE. GET ENTRY
TRNE IBEAR,100 ;DIRS 4 AND 6 ARE FIRST 5 7 SEC
ADDI T2,1
HRLM T1,JMOVE(T2) ;MAKE PSEUDO
JRST PD1
MLEG1: MOVEI T1,100000
MOVE T2,LM(B) ;GET POINTER
HRLM T1,JMOVE+2(T2) ;MAKE REAL
MOVE B,JMOVE+2(T2) ;THIS WILL POINT TO JBEAR
HRLM T1,JBEAR(B) ;MAKE REAL
SKIPGE B,JMOVE+3(T2) ;ALSO MOVE 4 IF THERE
JRST PD1
HRLM T1,JBEAR(B)
HRLM T1,JMOVE+3(T2) ;FALLS THROUGH TO PD1
PD1: ;READY TO UPDATE NEXT DIR.
ADDI MDIR,100 ;DIR INCREASE BY 1 SO THIS BY 100
ADDI IBEAR,100 ;SAME HERE
AOBJN DIR,L24 ;NEXT DIRECTION IF ANY LEFT
JUMPGE DEST,P1 ;ALL DONE HERE. NEXT CODE IF MOVING
;OFF OF BOARD
;UPDATE MATERIAL SAME AS BEFORE
MOVE T1,KIND(MOVER)
MOVN T1,VALUE(T1) ;BUT THIS TIME SUBTRACT
CAIGE MOVER,20
ADDM T1,WCOUNT ;BY ADDING NEGATIVE
CAIL MOVER,20
ADDM T1,BCOUNT
JRST PTIM ;IF GOING OFF BOARD DONE AT THIS POINT
;FOLLOWING CODE ALMOST EXACTLY SAME AS L21 SO NO COMMENTS
;THIS REMOVES BEARINGS AND MOVES MADE INVALID
P1: MOVEI MDIR,0
HRLZI DIR,-10
MOVE IBEAR,DEST
L44: SKIPGE B,JBEAR(IBEAR)
JRST PE1
HRRZS B
MOVE K,KIND(B)
CAIN K,PAWN
JRST PE2
SKIPGE N,NEXT(IBEAR)
JRST PE1
MOVE T1,LOC(B)
LDB M,DISTBL(DEST)
ADD M,EIGHTX(DIR)
ADD M,LM(B)
PE3: MOVEI T1,@N
SETOM JBEAR(T1)
SETOM JMOVE(M)
CAIE K,KING
JRST L45
MOVE T2,N
CAIL B,20
IORI T2,100
SETOM KDIR(T2)
L45: SKIPL OCC(N)
JRST PE1
SKIPGE N,NEXT(T1)
JRST PE1
AOJA M,PE3
PE2: MOVE T1,RANK(DEST)
CAIGE B,20
JRST L51
CAIE MDIR,300
JRST MLEG2
CAIN T1,5
JRST L52
JRST MIL2
L51: CAIE MDIR,100
JRST MLEG2
CAIE T1,2
JRST MIL2
JRST L52
MLEG2: MOVEI T1,0
HRLM T1,JBEAR(IBEAR)
MOVE T2,LM(B)
TRNE IBEAR,100
ADDI T2,1
HRLM T1,JMOVE(T2)
JRST PE1
MIL2: MOVEI T1,200000 ;PSEUDO-BIT
MOVE T2,LM(B) ;POINTER TO MOVE TABLE
HRLM T1,JBEAR(IBEAR) ;THIS IS PSEUDO
SKIPGE JMOVE+3(T2) ;IS MOVE 4 THERE?
JRST MIL3
HRLM T1,JMOVE+3(T2) ;YES, THIS PSEUDO ELSE MOVE 3
JRST PE1
MIL3: HRLM T1,JMOVE+2(T2)
JRST PE1
L52: MOVE T1,IBEAR
CAIGE B,20
ADDI T1,10
CAIL B,20
SUBI T1,10
SETOM JBEAR(T1)
MOVE T2,LM(B)
SETOM JMOVE+3(T2)
MOVEI T1,200000
HRLM T1,JMOVE+2(T2)
HRLM T1,JBEAR(IBEAR)
PE1: ADDI MDIR,100
ADDI IBEAR,100
AOBJN DIR,L44
;HERE IS WHERE WE PUT IN THE MOVES AND BEARINGS OF THE
;MOVED PIECE FROM ITS MOVED POSITION
MOVE K,KIND(MOVER) ;GET THE KIND OF PIECE
XCT TB1(K) ;SOMETIMES A JUMP OTHERS A MOVE
; THIS SECTION HANDLES ALL BUT PAWNS ,KNIGHTS ,AND KINGS
PFRB5: HRRZ MDIR,DIR ;DIR WAS LOADED BY THE EXECUTE
;OR THE SPECIAL KING ROUTINE
LSH MDIR,6 ;MULTIPLY BY 100
PFRB4: HRRZ M,DIR ;GET THE DIRECTION
LSH M,3 ;TIMES 10
ADD M,LM(MOVER) ;A POINTER TO MOVE TABLE
MOVE N,DEST ;SETTING UP POINTER TO SQUARE
HRLI N,MDIR ;MAKE IT LOOK LIKE LOADED FROM NEXT
MOVE T1,MDIR ;CREATE POINTER TO NEXT TABLE
IOR T1,N ;THE REST OF IT
PFRB3: SKIPGE N,NEXT(T1) ;GET THE NEXT SQUARE
JRST PF1 ;OFF THE BOARD
MOVEI T1,@N ;THE SAME TRICK FOR N+MDIR
MOVEM MOVER,JBEAR(T1) ;UPDATE BEARINGS
HRRZM T1,JMOVE(M) ;AND MOVE TABLE
PFRB2: SKIPGE OCC(N) ;IS IT OCCUPIED
AOJA M,PFRB3 ;NO NEXT MOVE
PF1: ADDI MDIR,100 ;GO TO NEXT DIRECTION
AOBJN DIR,PFRB4 ;IF ANY LEFT
JRST PTIM ;IF NONE LEFT, EXIT
;HERE IS A SIMILAR PIECE OF CODE USED FOR KING MOVES
PKING: MOVEI MDIR,0
MOVE T1,COLOR ;SET NO QSCAST AND KSCAST BECAUSE OF MOVED
TRO FL,20(T1)
TLO FL,20(T1)
PKING4: HRRZ M,DIR
LSH M,3
ADD M,LM(MOVER)
MOVE N,DEST
HRLI N,MDIR
MOVE T1,MDIR
IOR T1,N
PKING3: SKIPGE N,NEXT(T1)
JRST PK1
MOVEI T1,@N
MOVEM MOVER,JBEAR(T1)
HRRM T1,JMOVE(M)
HLLM MOVER,JMOVE(M) ;MAY HAVE PSEUDO-BIT ON
HRRZS MOVER ;TURN IT OFF
MOVE I,N ;MUST ALSO UPDATE KDIR
CAIL MOVER,20 ;WHY BIT WAS TURNED OFF
IORI I,100
MOVE T2,OPP(DIR)
MOVEM T2,KDIR(I)
HRLI MOVER,200000 ;ALWAYS PSEUDO BUT FIRST
SKIPGE OCC(N) ;IS IT OCCUPIED
AOJA M,PKING3 ;NO, NEXT MOVE
PK1: ADDI MDIR,100
HRRZS MOVER ;TURN OFF BIT
AOBJN DIR,PKING4
JRST PTIM
RKMV: MOVE T1,COLOR ;SET ROOK MOVED
TRNE MOVER,1 ;WHICH ONE
TROA FL,20(T1)
TLO FL,20(T1)
HRLZI DIR,-4 ;SET UP FOR MOVE
JRST PFRB5
;HERE IS THE TABLE OF THINGS EXECUTED
TB1: JRST PFP ;FOR PAWNS
JRST RKMV ;GO SET MOVED ROOK FLAG
JRST PFN ;DO KNIGHTS
MOVE DIR,[XWD -4,4] ;DIR 4-7 FOR BISHOPS
HRLZI DIR,-10 ;10 DIRECTIONS FOR QUEEN
JRST KSET ;SPECIAL KING ROUTINE
KSET: CAIGE MOVER,20 ;THIS ZEROS KDIR
JRST KS1
MOVE DIR,[XWD KDIR+100,KDIR+101] ;SET FOR BLT
SETOM KDIR+100 ;WOULD YOU BELIEVE -1 INSTEAD OF 0
BLT DIR,KDIR+177 ;SET ALL FOR THIS COLOR
HRLZI DIR,-10 ;ALL DIRECTIONS FOR KING
JRST PKING ;GO DO IT
KS1: MOVE DIR,[XWD KDIR,KDIR+1] ;SAME BUT FOR OTHER KING
SETOM KDIR
BLT DIR,KDIR+77
HRLZI DIR,-10
JRST PKING
;HERE FOR KNIGHTS
PFN: MOVE DIR,[XWD -10,10] ;DIRS 10-17
MOVE MDIR,DEST
IORI MDIR,1000 ;SET UP MDIR
PFN2: SKIPGE N,NEXT(MDIR) ;GET SQUARE IN THAT DIR
JRST PFN1 ;OFF BOARD
MOVE T1,DIR ;GET THE DIRECTION
LSH T1,6 ;TIMES 100
IOR T1,N ;PUT IN SQUARE
MOVEM MOVER,JBEAR(T1) ;SET UP BEARINGS
MOVEI T2,-10(DIR) ;MAGIC FOR POINTER TO MOVE TABLE
ADD T2,LM(MOVER)
HRRZM T1,JMOVE(T2) ;PUT IN MOVE
PFN1: ADDI MDIR,100 ;NEXT DIRECTION
AOBJN DIR,PFN2 ;IF THERE IS ONE
JRST PTIM ;ELSE EXIT
;HERE ARE PAWNS, THEY ARE RATHER HORRIBLE
PFP: MOVE M,LM(MOVER) ;POINTER TO MOVE TABLE
CAIL MOVER,20 ;WHICH COLOR?
JRST BLACKP
MOVEI DIR,400 ;DIRECTION 4 FIRST
IOR DIR,DEST ;CURRENT SQUARE
SKIPGE N,NEXT(DIR) ;GET NEXT
JRST PF3 ;OFF BOARD, TRY NEXT DIR
SKIPGE OCC(N) ;SOMEONE THERE?
HRLI MOVER,40000 ;NO, ONLY PSEUDO
IORI N,400 ;PUT IN DIRECTION
MOVEM MOVER,JBEAR(N) ;PUT IN BEARINGS
HRRZM N,JMOVE(M) ;AND MOVE
HLLM MOVER,JMOVE(M) ;MAKE SURE PSEUDO-BIT GET THERE
PF3: SKIPGE N,NEXT+100(DIR) ;SIMILAR FOR DIR 5
JRST PF3P
HRRZS MOVER ;GET RID OF PSEUDO-BIT
SKIPGE OCC(N) ;SOMEONE THERE?
HRLI MOVER,40000 ;NO
IORI N,500
MOVEM MOVER,JBEAR(N)
HRRZM N,JMOVE+1(M) ;ALWAYS SECOND LOCATION IN BLOCK
HLLM MOVER,JMOVE+1(M)
PF3P: MOVE IBEAR,DEST ;NOW FOR DIR 1
ADDI IBEAR,110 ;PUT IN DIRECTION AND DO NEXT AT SAME TIME
HRLI MOVER,100000 ;GET RID OF PSEUDO-BIT
SKIPL OCC-100(IBEAR) ;SOMEONE THERE?
HRLI MOVER,200000
MOVEM MOVER,JBEAR(IBEAR) ;PUT IN BEARING
HRRZM IBEAR,JMOVE+2(M) ;AND MOVE
HLLM MOVER,JMOVE+2(M)
MOVE T1,RANK(DEST) ;CHECKING TO SEE IF COULD
CAIN T1,1 ;MOVE FORWARD 2
SKIPL OCC+10(DEST) ;MAYBE SOMEONE IN WAY
JRST PTIM ;CAN NOT MOVE 2
ADDI IBEAR,10 ;YES WE CAN
HRLI MOVER,100000
SKIPL OCC+20(DEST)
HRLI MOVER,200000
MOVEM MOVER,JBEAR(IBEAR) ;SET UP BEARING
HRRZM IBEAR,JMOVE+3(M) ;AND MOVE
HLLM MOVER,JMOVE+3(M)
JRST PTIM ;AND EXIT
BLACKP: MOVEI DIR,600 ;BLACP PAWNS ARE SIMILAR
IOR DIR,DEST
SKIPGE N,NEXT(DIR)
JRST PF4
SKIPGE OCC(N)
HRLI MOVER,40000
IORI N,600
MOVEM MOVER,JBEAR(N)
HRRZM N,JMOVE(M)
HLLM MOVER,JMOVE(M)
PF4: SKIPGE N,NEXT+100(DIR)
JRST PF4P
HRRZS MOVER
SKIPGE OCC(N)
HRLI MOVER,40000
IORI N,700
MOVEM MOVER,JBEAR(N)
HRRZM N,JMOVE+1(M)
HLLM MOVER,JMOVE+1(M)
PF4P: MOVE IBEAR,DEST
ADDI IBEAR,270
HRLI MOVER,100000
SKIPL OCC-10(DEST)
HRLI MOVER,200000
MOVEM MOVER,JBEAR(IBEAR)
HRRZM IBEAR,JMOVE+2(M)
HLLM MOVER,JMOVE+2(M)
MOVE T1,RANK(DEST)
CAIN T1,6
SKIPL OCC-10(DEST)
JRST PTIM
SUBI IBEAR,10
HRLI MOVER,100000
SKIPL OCC-20(DEST)
HRLI MOVER,200000
MOVEM MOVER,JBEAR(IBEAR)
HRRZM IBEAR,JMOVE+3(M)
HLLM MOVER,JMOVE+3(M)
JRST PTIM
;HERE ARE THE TABLES
NEXT: BLOCK 2000
LOC: BLOCK 41 ;OCC NEEDS A -1 POSITION
OCC: BLOCK 100
JBEAR: BLOCK 2000
KDIR: BLOCK 200
JMOVE: BLOCK 4000
KIND: REPEAT 2,<EXP 1,2,3,4,5,3,2,1
REPEAT 10,<Z>>
VALUE: EXP 1,5,3,3,11,1000
RANK: FOO=0
REPEAT 10,<REPEAT 10,<EXP FOO>
FOO=FOO+1>
FILE: REPEAT 10,<EXP 0,1,2,3,4,5,6,7>
OPP: EXP 2,3,0,1,6,7,4,5,14,15,16,17,10,11,12,13
LM: FOO=0
REPEAT 2,<XWD -10,FOO
FOO=FOO+100
XWD 7,FOO
FOO=FOO+100
REPEAT 4,<XWD -10,FOO
FOO=FOO+100>
XWD 7,FOO
FOO=FOO+100
XWD -10,FOO
FOO=FOO+100
REPEAT 10,<XWD 3,FOO
FOO=FOO+100>>
EIGHTX: EXP 0,10,20,30,40,50,60,70,100,110,120,130,140,150,160,170,200
DISTBL: FOO=0
REPEAT 5,<X=2
REPEAT 14,<POINT 3,BTB+FOO(T1),X
X=X+3>
FOO=FOO+100>
X=2
REPEAT 4,<POINT 3,BTB+500(T1),X
X=X+3>
BTB: BLOCK 600
;MAGIC ROUTINES TO SET UP NEXT AND BTB
SETBTB: MOVEI T1,77
MOVEI T2,77
MOVE 1,RANK(T1)
CAMN 1,RANK(T2) ;IF RANKS SAME DISTANCE IS DIFF OF FILES
JRST L22
SUB 1,RANK(T2) ;ELSE DIFF OF RANKS SINCE HORIZ
JRST L23 ;VERT. OR DIAGONAL
L22: MOVE 1,FILE(T1)
SUB 1,FILE(T2)
L23: MOVMS 1 ;GET MAGNITUDE
DPB 1,DISTBL(T2) ;PUT IN PLACE
SOJGE T2,SETBTB+2 ;REPEAT
SOJGE T1,SETBTB+1 ;FOR ALL PAIRS OF SQUARES
POPJ P, ;EXIT
;SET UP NEXT
NXTSET: MOVEI I,0 ;INDEX TO NEXT TABLE
HRLZI N,-20 ;DIRECTIONS
NXS3: HLRE T1,TBST(N) ;Y DIF FOR THIS DIR
HRRE T2,TBST(N) ;X DIF
HRLZI K,-10 ;Y LOCATION
NXS2: HRLZI B,-10 ;X LOCATION
NXS1: HRRZ 0,B ;GET X COORDINATE
ADD 0,T2 ;ADD X CHANGE
JUMPL 0,NG ;NEGATIVE IS OFF BOARD
CAILE 0,7
JRST NG ;SO IS GREATER THAN 7
HRRZ DIR,K ;SAME FOR Y
ADD DIR,T1
JUMPL DIR,NG
CAILE DIR,7
JRST NG
LSH DIR,3 ;MAKE IT A SQUARE BY SQ=Y*10+X
IOR DIR
HRLI MDIR ;PUT IN THE MAGIC MDIR
MOVEM 0,NEXT(I) ;PUT IN TABLE
NXS4: ADDI I,1 ;NEXT ENTRY
AOBJN B,NXS1
AOBJN K,NXS2
AOBJN N,NXS3
POPJ P, ;ALL DONE
NG: SETOM NEXT(I) ;ENTER OFF THE BOARD
JRST NXS4 ;DO REST
TBST: BYTE (18) 0,-1,1,0,0,1,-1,0,1,-1,1,1,-1,1,-1,-1
BYTE (18) 2,-1,2,1,1,2,-1,2,-2,1,-2,-1,-1,-2,1,-2
EXTERNAL COLOR,OFBTB,PCTB,POSTB,PTCTR,TMPUT,TIMIT
TIMR=4000
PTIM: TRNN FL,TIMR
POPJ P,
PUSH P,SVPTM
PUSHJ P,TIMIT
POP P,T1
ADDM T1,TMPUT
POPJ P,
INTERNAL LOC,SETBTB,NXTSET,BCOUNT,WCOUNT,OCC,JMOVE,PUTCH,KIND,LM,RANK,JBEAR,FILE,VALUE
END